/* GUI CONVERTED from rcctwbc2.p (converter v1.76) Tue Aug 20 15:41:44 2002 */
/* rcctwbc2.p  - CONTAINER WORKBENCH - SUB PROGRAM - ADD ITEM                 */
/* Copyright 1986-2002 QAD Inc., Carpinteria, CA, USA.                        */
/* All rights reserved worldwide.  This is an unpublished work.               */
/* $Revision: 1.7.1.23 $                                                       */
/*V8:ConvertMode=Maintenance                                                  */
/* VERSION 7.5        LAST MODIFIED: 04/14/95           BY: GWM *J049*        */
/* VERSION 8.5        LAST MODIFIED: 04/12/96           BY: GWM *J0J1*        */
/* REVISION: 8.6      LAST MODIFIED: 08/03/96   BY: *K003* Vinay Nayak-Sujir  */
/* REVISION: 8.6      LAST MODIFIED: 10/03/96   BY: *K003* Kieu Nguyen        */
/* REVISION: 8.6      LAST MODIFIED: 10/31/96   BY: *K003* Steve Goeke        */
/* REVISION: 8.6      LAST MODIFIED: 12/25/96   BY: *K03R* Vinay Nayak-Sujir  */
/* REVISION: 8.6      LAST MODIFIED: 08/21/97   BY: *J1ZC* Aruna Patil        */
/* REVISION: 8.6E     LAST MODIFIED: 02/23/98   BY: *L007* A. Rahane          */
/* REVISION: 8.6E     LAST MODIFIED: 05/20/98   BY: *K1Q4* Alfred Tan         */
/* REVISION: 8.6E     LAST MODIFIED: 07/22/98   BY: *J2M7* Niranjan R.        */
/* REVISION: 8.6E     LAST MODIFIED: 08/18/99   BY: *K223* Santosh Rao        */
/* REVISION: 8.6E     LAST MODIFIED: 09/16/99   BY: *K21D* Poonam Bahl        */
/* REVISION: 8.6E     LAST MODIFIED: 02/10/00   BY: *L0RB* Sandeep Rao        */
/* REVISION: 9.1      LAST MODIFIED: 03/24/00   BY: *N08T* Annasaheb Rahane   */
/* REVISION: 9.1      LAST MODIFIED: 04/13/00   BY: *K250* Surekha Joshi      */
/* REVISION: 9.1      LAST MODIFIED: 06/26/00   BY: *L107* Ashwini G.         */
/* REVISION: 9.1      LAST MODIFIED: 08/12/00   BY: *N0KP* myb                */
/* REVISION: 9.1      LAST MODIFIED: 09/05/00   BY: *N0R9* Mudit Mehta        */
/* Revision: 1.7.1.18     BY: Jean Miller       DATE: 03/22/01 ECO: *P008*    */
/* Revision: 1.7.1.19     BY: Dan Herman        DATE: 07/09/01 ECO: *P007*    */
/* Revision: 1.7.1.20     BY: Rajaneesh S.      DATE: 02/21/02 ECO: *L13N*    */
/* Revision: 1.7.1.22   BY: Ashish Maheshwari DATE: 07/17/02 ECO: *N1GJ*    */
/* $Revision: 1.7.1.23 $  BY: Samir Bavkar    DATE: 08/15/02 ECO: *P09K*   */
/******************************************************************************/
/* All patch markers and commented out code have been removed from the source */
/* code below. For all future modifications to this file, any code which is   */
/* no longer required should be deleted and no in-line patch markers should   */
/* be added.  The ECO marker should only be included in the Revision History. */
/******************************************************************************/

{mfdeclre.i}
{gplabel.i} /* EXTERNAL LABEL INCLUDE */

/* ********** Begin Translatable Strings Definitions ********* */

&SCOPED-DEFINE rcctwbc2_p_1 "Comments"
/* MaxLen: Comment: */

&SCOPED-DEFINE rcctwbc2_p_2 "Multi Entry"
/* MaxLen: Comment: */

&SCOPED-DEFINE rcctwbc2_p_5 "Item Number"
/* MaxLen: Comment: */

&SCOPED-DEFINE rcctwbc2_p_7 "Conversion"
/* MaxLen: Comment: */

&SCOPED-DEFINE rcctwbc2_p_8 "Ref"
/* MaxLen: Comment: */

&SCOPED-DEFINE rcctwbc2_p_9 "Volume"
/* MaxLen: Comment: */

/* ********** End Translatable Strings Definitions ********* */

{rcinvtbl.i new}

/* INPUT PARAMETERS */
define input parameter ship_from as character.
define input parameter temp_parent as character.

/* OUTPUT PARAMETERS */
define output parameter abnormal_exit as logical.

/* SHARED VARIABLES TO CALL EXISTING CODE */
define new shared variable multi_entry as log no-undo.
define new shared variable cline as character.
define new shared variable lotserial_control like pt_lot_ser.

define new shared variable issue_or_receipt as character.
define new shared variable total_lotserial_qty like sr_qty.
define new shared variable site like sr_site no-undo.
define new shared variable location like sr_loc no-undo.
define new shared variable lotserial like sr_lotser no-undo.
define new shared variable lotserial_qty like sr_qty no-undo.
define new shared variable trans_um like pt_um.
define new shared variable trans_conv like sod_um_conv.
define new shared variable transtype as character initial "ISS-UNP".
define new shared variable lotref like sr_ref no-undo.

define new shared variable cmtindx like cmt_indx.
define new shared variable new_site as character.
define new shared variable so_db as character.
define new shared variable err_stat as integer.

/* LOCAL VARIABLES */
define variable part_item like pt_part label {&rcctwbc2_p_5} no-undo.
define variable part_site like abs_site no-undo.
define variable item_description like pt_desc1 format "x(20)" no-undo.
define variable item_description_2 like pt_desc2 format "x(20)" no-undo.
define variable part_loc like abs_loc no-undo.
define variable part_wght like pt_net_wt no-undo.
define variable part_wt_um like pt_net_wt_um no-undo.
define variable part_vol like pt_size label {&rcctwbc2_p_9} no-undo.
define variable part_vol_um like pt_size_um no-undo.
define variable multiple like mfc_logical label {&rcctwbc2_p_2} no-undo.
define variable nullstr as character no-undo.
define variable undotran as logical no-undo.
define variable i as integer no-undo.
define variable part_qty like sr_qty no-undo.
define variable part_lot_ser like abs_lot no-undo.
define variable part_ref like abs_ref label {&rcctwbc2_p_8} no-undo.
define variable qty_to_set as integer no-undo.
define variable qty_per as integer no-undo.
define variable qty_modulo as integer no-undo.
define variable part_qty_um like pt_um no-undo.
define variable part_qty_conv like um_conv label {&rcctwbc2_p_7} no-undo.
define variable num_containers as integer no-undo.
define variable this_rec_qty as integer no-undo.
define variable error_flag as integer no-undo.
define variable shipgrp like sgad_grp no-undo.
define variable par_absid like abs_id no-undo.
define variable par_shipfrom like abs_shipfrom no-undo.
define variable first_parent like mfc_logical no-undo.
define variable cmmts like mfc_logical label {&rcctwbc2_p_1} no-undo.

define variable l_abs_tot_tare_wt like abs_nwt    no-undo.
define variable l_abs_tot_net_wt  like abs_nwt    no-undo.
define variable l_pt_ship_wt      like pt_ship_wt no-undo.
define variable l_recid           as   recid      no-undo.
define variable l_par_cont        like abs_id     no-undo.
define variable l_item_id         like abs_id     no-undo.
define variable l_conv            as   decimal    no-undo.
define variable l_this_rec_qty    like abs_qty    no-undo.

define variable lotnext like wo_lot_next.
define variable lotprcpt like wo_lot_rcpt no-undo.
define variable line_recno as recid.
define variable part_order like abs_order label "Sales Order" no-undo.
define variable part_order_line like abs_line label "Order Line" no-undo.
define variable vShipToCode like so_ship no-undo.
define variable vSoRecno  as recid no-undo.
define variable vSodRecno as recid no-undo.
define variable use-log-acctg as logical no-undo.
define variable l_FrTermsErr like mfc_logical no-undo.
define variable l_FrTermsOnFirstOrder like so_fr_terms no-undo.

define new shared temp-table work_sr_wkfl like sr_wkfl.

/* BUFFERS */
define buffer parent_container for abs_mstr.
define buffer abs_buff for abs_mstr.
define buffer abs_buff1 for abs_mstr.
define buffer abs_buff2 for abs_mstr.

/* VARIABLE DEFINITIONS FOR gpfile.i */
{gpfilev.i}

assign
   issue_or_receipt = getTermLabel("ISSUE",8).

/* FORM FOR ADD CONTAINERS */

/*GUI preprocessor Frame A define */
&SCOPED-DEFINE PP_FRAME_NAME A

FORM /*GUI*/ 
   
 RECT-FRAME       AT ROW 1.4 COLUMN 1.25
 RECT-FRAME-LABEL AT ROW 1   COLUMN 3 NO-LABEL
 SKIP(.1)  /*GUI*/
part_item          colon 25
   item_description   at 27    no-label
   item_description_2 at 27    no-label
   part_qty           colon 25
   part_site          colon 54
   part_qty_um        colon 25
   part_loc           colon 54
   part_qty_conv      colon 25
   part_lot_ser       colon 54
   part_ref           colon 54
   part_wght          colon 25
   part_wt_um                  no-label
   multiple           colon 54
   part_vol           colon 25
   part_vol_um                 no-label
   cmmts              colon 54
   part_order colon 25
   part_order_line colon 54
   skip(1)
 SKIP(.4)  /*GUI*/
with frame a width 80 side-labels
 attr-space NO-BOX THREE-D /*GUI*/.

 DEFINE VARIABLE F-a-title AS CHARACTER.
 F-a-title = (getFrameTitle("ITEM_INFORMATION",24)).
 RECT-FRAME-LABEL:SCREEN-VALUE in frame a = F-a-title.
 RECT-FRAME-LABEL:WIDTH-PIXELS in frame a =
  FONT-TABLE:GET-TEXT-WIDTH-PIXELS(
  RECT-FRAME-LABEL:SCREEN-VALUE in frame a + " ", RECT-FRAME-LABEL:FONT).
 RECT-FRAME:HEIGHT-PIXELS in frame a =
  FRAME a:HEIGHT-PIXELS - RECT-FRAME:Y in frame a - 2.
 RECT-FRAME:WIDTH-CHARS IN FRAME a = FRAME a:WIDTH-CHARS - .5. /*GUI*/

/*GUI preprocessor Frame A undefine */
&UNDEFINE PP_FRAME_NAME



/* SET EXTERNAL LABELS */
setFrameLabels(frame a:handle).

/* CHECK IF LOGISTICS ACCOUNTING IS ENABLED */
{gprun.i ""lactrl.p"" "(output use-log-acctg)"}
/*GUI*/ if global-beam-me-up then undo, leave.


{cclc.i} /* DETERMINE IF USING CONTAINER AND LINE CHARGES*/

/* INITIALIZE CENTRAL DATABASE ALIAS NAME */
assign
   so_db = global_db
   abnormal_exit = true
   cline = global_db + "rcctwbc2.p".

/* ADD OR CREATE CONTAINERS */
main:
do on endkey undo main, leave main
   on error undo main, retry main:
/*GUI*/ if global-beam-me-up then undo, leave.


   set
      part_item
   with frame a editing:

      {mfnp.i pt_mstr
         part_item
         pt_part
         part_item
         pt_part
         pt_part}

      if recno <> ? then do:
         display
            pt_part @ part_item
            pt_desc1 @ item_description
            pt_desc2 @ item_description_2
         with frame a.
      end.

   end. /* EDITING */

   assign
      new_site    = ship_from
      global_part = part_item.

   /* VALIDATE THAT PART EXISTS AT THE SITE */
   {gprun.i ""gpptsi01.p""}
/*GUI*/ if global-beam-me-up then undo, leave.


   if err_stat = 2 then do:
      {pxmsg.i &MSGNUM=16 &ERRORLEVEL=3} /* PART NOT FOUND */
      undo main, retry main.
   end.

   find pt_mstr where pt_part = part_item no-lock.
   display
      pt_desc1 @ item_description
      pt_desc2 @ item_description_2
      pt_um @ part_qty_um
   with frame a.

   /* ASSIGN DEFAULTS */
   assign
      part_loc = pt_loc
      part_site = ship_from
      part_qty = 0
      part_qty_um = pt_um
      part_qty_conv = 1
      part_wght = pt_net_wt
      part_wt_um = pt_net_wt_um
      part_vol = pt_size
      part_vol_um = pt_size_um
      part_lot_ser = ""
      part_ref = ""
      cmmts = false
      multiple = false
      part_order = ""
      part_order_line = ""
      lotserial_control = pt_lot_ser.

   display
      part_site
      part_loc
      part_lot_ser
      part_ref
      part_qty
      part_qty_um
      part_qty_conv
      part_wght
      part_wt_um
      part_vol
      part_vol_um
      multiple
      cmmts
      part_order
      part_order_line
   with frame a.

   /* GET INVENTORY DETAIL INFORMATION */
   inv_detail:
   do on endkey undo main, retry main
      on error undo inv_detail, retry inv_detail:
/*GUI*/ if global-beam-me-up then undo, leave.


      set
         part_qty
         part_qty_um
         part_qty_conv
         part_wght
         part_wt_um
         part_vol
         part_vol_um
         part_order when (using_container_charges or using_line_charges)
         part_site
         part_loc
         part_lot_ser
         part_ref
         multiple
         cmmts
         part_order_line when (using_container_charges or using_line_charges)
      with frame a.

      /* CHECK FOR CONVERSION FACTOR */
      if part_qty_um <> pt_um then do:

         if not part_qty_conv entered then do:

            {gprun.i ""gpumcnv.p""
               "(input part_qty_um,
                 input pt_um,
                 input pt_part,
                 output part_qty_conv)"}
/*GUI*/ if global-beam-me-up then undo, leave.


            if part_qty_conv = ? then do:
               {pxmsg.i &MSGNUM=33 &ERRORLEVEL=2} /* NO UM CONVERSION EXISTS */
               part_qty_conv = 1.
            end.

            display
               part_qty_conv
            with frame a.

         end. /* IF NOT PART_QTY_CONV ENTERED */

      end. /* IF PART_QTY_UM <> PT_UM */

      if part_site <> ship_from then do:

         {gprun.i ""gpgetgrp.p""
            "(input part_site,
              input ship_from,
              output shipgrp)"}
/*GUI*/ if global-beam-me-up then undo, leave.


         if shipgrp <> ? then do:
            find sg_mstr where sg_grp = shipgrp
            no-lock no-error.
            if available sg_mstr and
               sg_auto_tr = no
            then do:
               /* Automatic transfer from site # to site # prohibited */
               {pxmsg.i &MSGNUM=5845 &ERRORLEVEL=3
                        &MSGARG1=part_site
                        &MSGARG2=ship_from}
               undo main, retry main.
            end.
         end. /* if shipgrp <> ? */

      end. /* if part_site <> ship_from  */
      if using_container_charges or
         using_line_charges then do:
         assign
            vSoRecno = ?
            vSodRecno = ?
            vShipToCode = "".

          /* VALIDATE SALES ORDER and ORDER LINE */
         if part_order_line <> "" or part_order <> "" then do:
            for first so_mstr no-lock where
               so_nbr = input part_order:
            end.
            if not available so_mstr then do:
               {pxmsg.i &MSGNUM=609 &ERRORLEVEL=3}
               /*SALES ORDER DOES NOT EXIST*/
               undo inv_detail, retry inv_detail.
            end.
            for first sod_det no-lock where
               sod_nbr = part_order and
               sod_line = integer(part_order_line):
            end.
            if not available sod_det then do:
               {pxmsg.i &MSGNUM=764 &ERRORLEVEL=3}
               /*SALES ORDER LINE DOES NOT EXIST*/
               undo inv_detail, retry inv_detail.
            end.
            if sod_part <> part_item then do:
               {pxmsg.i &MSGNUM=8285 &ERRORLEVEL=3}
               /*MATCHING SO LINE ITEM FOR THIS... */
               undo inv_detail, retry inv_detail.
            end.
            assign
               vSoRecno = recid(so_mstr)
               vSodRecno = recid(sod_det)
               vShipToCode = (if sod_dock > "" then sod_dock else
                              if sod_ship > "" then sod_ship else
                              so_ship).

            /* SALES ORDER AND LINE CAN ONLY BE ENTERED WHEN USING CONTAINER */
            /* AND LINE CHARGES MODULE. VALIDATE FR TERMS IF LOGISTICS       */
            /* ACCOUNTING IS ENABLED.                                        */
            if use-log-acctg then do:
               /* VALIDATE SALES ORDER FREIGHT TERMS FOR THIS CONTAINER */
               run validateSOFrTerms (input ship_from,
                                      input temp_parent,
                                      input so_fr_terms,
                                      output l_FrTermsOnFirstOrder,
                                      output l_FrTermsErr).
               if l_FrTermsErr then do:
                  /* ALL ATTACHED ORDERS MUST HAVE FREIGHT TERMS # */
                  {pxmsg.i &MSGNUM=5056 &ERRORLEVEL=3
                           &MSGARG1= l_FrTermsOnFirstOrder}
                  undo inv_detail, retry inv_detail.
               end. /* IF l_FrTermsErr */
            end.   /* if use-log-acctg */

         end.
/*GUI*/ if global-beam-me-up then undo, leave.
 /* IF PART_ORDER */
      end.
/*GUI*/ if global-beam-me-up then undo, leave.
 /* IF USING_CONTAINER_CHARGES ...*/

      /* DELETE OLD SR_WKFL RECORDS */
      for each sr_wkfl where sr_userid = mfguser exclusive-lock:
         delete sr_wkfl.
      end.

      for each lotw_wkfl
         where lotw_mfguser = mfguser
         exclusive-lock:
         delete lotw_wkfl.
      end. /* FOR EACH lotw_wkfl */


      /* SWITCH TO THE REMOTE SITE IF NECESSARY */
      {gprun.i ""gpalias2.p""
         "(input part_site, output error_flag)"}
/*GUI*/ if global-beam-me-up then undo, leave.


      if error_flag <> 0 and error_flag <> 9 then do:
         /* UNABLE TO CONNECT TO REMOTE DATABASE */
         {pxmsg.i &MSGNUM=2510 &ERRORLEVEL=4
            &MSGARG1=" ""'"" +
                     getTermLabel(""FOR_REMOTE_INVENTORY"",30) + ""'"" "}
         undo inv_detail, retry inv_detail.
      end.

      /* DELETE OLD SR_WKFL RECORDS */
      for each sr_wkfl where sr_userid = mfguser exclusive-lock:
         delete sr_wkfl.
      end.

      for each lotw_wkfl
         where lotw_mfguser = mfguser
         exclusive-lock:
         delete lotw_wkfl.
      end. /* FOR EACH lotw_wkfl */

      if not multiple then do:

         /* VALIDATE THE INVENTORY DETAIL INFORMATION */
         {gprun.i ""rcctmtb.p""
            "(input transtype,
              input ship_from,
              input part_site,
              input part_loc,
              input part_item,
              input part_lot_ser,
              input part_ref,
              input part_qty,
              input part_qty_um,
              input part_qty_conv,
              output undotran)"}
/*GUI*/ if global-beam-me-up then undo, leave.


         if undotran then do:
            /* RESET TO CENTRAL DATABASE IF NECESSARY */
            {gprun.i ""gpalias3.p""
               "(input so_db, output error_flag)"}
/*GUI*/ if global-beam-me-up then undo, leave.

            undo inv_detail, retry inv_detail.
         end.

      end. /* IF NOT MULTIPLE */

      /* SET THE MULTIPLE INFO IF NECESSARY */
      if multiple then do:

         assign
            cline = ""
            site = part_site
            location = part_loc
            lotserial = part_lot_ser
            lotserial_qty = part_qty
            trans_um = part_qty_um
            trans_conv = part_qty_conv
            lotnext = ""
            lotprcpt = no
            lotref = part_ref.

         /* MULTIPLE ENTRY ROUTINE */
         /* ADDED SIXTH INPUT PARAMETER AS NO */
         {gprun.i ""icsrup.p""
            "(input ship_from,
              input """",
              input """",
              input-output lotnext,
              input lotprcpt,
              input no)"}
/*GUI*/ if global-beam-me-up then undo, leave.


         /* HANDLE NO MULTIPLE ENTRY RECORDS CREATED CONDITION */
         find first sr_wkfl where sr_userid = mfguser no-lock no-error.

         if not available sr_wkfl then do:
            /* RESET TO CENTRAL DATABASE IF NECESSARY */
            {gprun.i ""gpalias3.p""
               "(input so_db, output error_flag)"}
/*GUI*/ if global-beam-me-up then undo, leave.

            undo inv_detail, retry inv_detail.
         end.

      end. /* IF MULTIPLE */

      /* SET WORK_SR_WKFL WORKFILE RECORDS */
      {gprun.i ""rcshmtb2.p""
         "(input mfguser, input cline)"}
/*GUI*/ if global-beam-me-up then undo, leave.


      /* RESET TO CENTRAL DATABASE IF NECESSARY */
      {gprun.i ""gpalias3.p""
         "(input so_db, output error_flag)"}
/*GUI*/ if global-beam-me-up then undo, leave.


   end. /* inv_detail */

   /* CREATE WORK_SR_WKFL FOR MULTI-ENTRY = FALSE */
   find first work_sr_wkfl where work_sr_wkfl.sr_userid = mfguser
   no-lock no-error.

   if not available work_sr_wkfl then do:
      create work_sr_wkfl.
      assign
         work_sr_wkfl.sr_userid = mfguser
         work_sr_wkfl.sr_site = part_site
         work_sr_wkfl.sr_loc = part_loc
         work_sr_wkfl.sr_lotser = part_lot_ser
         work_sr_wkfl.sr_ref = part_ref
         work_sr_wkfl.sr_qty = part_qty.
   end.

   num_containers = 0.

   /* COUNT THE NUMBER OF PARENT CONTAINERS FOR THIS ITEM */
   for each abs_mstr where
            abs_mstr.abs_shipfrom = ship_from
        and abs_mstr.abs_shipto = temp_parent
        and integer(abs__qad06) = 2
   no-lock:
      num_containers = num_containers + 1.
   end.

   part_qty = 0.

   /* COUNT THE QTY OF ITEMS FOR THE PARENT CONTAINERS */
   for each work_sr_wkfl where work_sr_wkfl.sr_userid = mfguser
   no-lock:
      part_qty = part_qty + work_sr_wkfl.sr_qty.
   end.

   /* AT THIS POINT NUM_CONTAINERS CONTAINS THE NUMBER OF PARENT    */
   /* RECORDS THAT THE ITEM QTY IS TO BE DIVIDED AMONGST. PART_QTY  */
   /* WILL CONTAIN THE TOTAL ITEM QTY                               */

   /* DETERMINE QUANTITY PER AND MODULO */
   assign
      qty_per = (part_qty - (part_qty modulo num_containers)) / num_containers
      qty_modulo = part_qty modulo num_containers.

   /* PART QUANTITIES WILL BE ASSIGNED TO PARENT CONTAINER RECORDS  */
   /* ON A CONSUMPTION BASIS I.E. SR_WKFL'S WILL BE FOUND ONE BY ONE*/
   /* AND AS MUCH OF THE QUANTITY THAT CAN, WILL BE APPLIED TO THE  */
   /* CURRENT RECORD UNTIL THE QUANTITY LEFT IS ZERO. THEN THE NEXT */
   /* SR_WKFL RECORD WILL BE APPLIED AND SO ON UNTIL ALL HAVE BEEN  */
   /* APPLIED                                                       */

   first_parent = yes.

   /* CREATE THE ALLOTED NUMBER OF CONTAINER RECORDS */
   /* FROM THE SR_WKFL RECORDS */
   for each parent_container
      where parent_container.abs_shipfrom = ship_from
        and parent_container.abs_shipto = temp_parent
        and integer(abs__qad06) = 2
   exclusive-lock:
/*GUI*/ if global-beam-me-up then undo, leave.


      /* SET PART QTY FOR THIS RECORD */
      qty_to_set = qty_per.

      /* ASSIGN MODULO QTY TO FIRST RECORD ONLY */
      if qty_modulo > 0 then do:
         qty_to_set = qty_to_set + qty_modulo.
         qty_modulo = 0.
      end.

      do while qty_to_set > 0:

         find first work_sr_wkfl where work_sr_wkfl.sr_userid = mfguser
         exclusive-lock.

         if num_containers > 1 then do:

            /* CASE SR_QTY IS MORE THAN REQUIRED */
            if work_sr_wkfl.sr_qty > qty_to_set then do:
               assign
                  work_sr_wkfl.sr_qty = work_sr_wkfl.sr_qty - qty_to_set
                  this_rec_qty = qty_to_set
                  qty_to_set = 0.
            end.
            /* CASE SR_QTY IS LESS THAN OR EQUAL AMT REQUIRED */
            else do:
               assign
                  this_rec_qty = work_sr_wkfl.sr_qty
                  qty_to_set = qty_to_set - work_sr_wkfl.sr_qty
                  work_sr_wkfl.sr_qty = 0.
            end.

            l_this_rec_qty = this_rec_qty.

         end. /* IF NUM_CONTAINERS > 1 */

         else do:
            assign
               l_this_rec_qty      = work_sr_wkfl.sr_qty
               work_sr_wkfl.sr_qty = 0.
         end. /* ELSE DO .. */

         /* CHECK FOR DUPLICATE RECORDS */
         find abs_mstr where
              abs_mstr.abs_shipfrom = ship_from
          and abs_mstr.abs_id = "I" + parent_container.abs_id +
                                work_sr_wkfl.sr_site + part_item +
                                work_sr_wkfl.sr_loc +
                                work_sr_wkfl.sr_lotser +
                                work_sr_wkfl.sr_ref
         no-lock no-error.

         if available abs_mstr then do:
            /* YOU CANNOT HAVE MULTIPLE ITEMS FOR SAME ... */
            {pxmsg.i &MSGNUM=753 &ERRORLEVEL=3}
            undo main, retry main.
         end.

         if cmmts and first_parent then do:
            /* The parent shipper if the container is attached to one */
            run get_abs_parent
               (input  parent_container.abs_id,
                input  ship_from,
                output par_absid,
                output par_shipfrom).

            if first_parent = yes then
               first_parent = no.

            if par_absid <> ? then do:
               find abs_buff where
                    abs_buff.abs_id = par_absid and
                    abs_buff.abs_shipfrom = par_shipfrom
               no-lock no-error.
               if available abs_buff then do:
                  assign
                     global_ref = abs_buff.abs_format
                     global_lang = abs_buff.abs_lang.
                  {gprun.i ""gpcmmt01.p"" "(input 'abs_mstr')"}
/*GUI*/ if global-beam-me-up then undo, leave.

               end.
            end. /* if par_absid <> ? */

         end. /* if cmmts and first_parent  */

         /* CREATE THE CONTAINER RECORD */
         l_item_id = "I" + parent_container.abs_id +
                     work_sr_wkfl.sr_site +
                     part_item +
                     work_sr_wkfl.sr_loc +
                     work_sr_wkfl.sr_lotser +
                     work_sr_wkfl.sr_ref.

         run p_create_item
            (input ship_from,
             input temp_parent,
             input l_item_id,
             input parent_container.abs_id,
             input l_this_rec_qty,
             input part_item,
             input work_sr_wkfl.sr_loc,
             input work_sr_wkfl.sr_lotser,
             input work_sr_wkfl.sr_ref,
             input part_wght,
             input part_wt_um,
             input part_vol,
             input part_vol_um,
             input work_sr_wkfl.sr_site,
             input part_qty_um,
             input part_qty_conv,
             input (if available pt_mstr then pt_ship_wt else part_wght),
             input cmtindx,
             input part_order,
             input part_order_line,
             output line_recno).

         if (using_container_charges or using_line_charges) then
            run CreateUserFields (input ship_from,
                                  input vShipToCode,
                                  input l_item_id).

         if using_line_charges then
            run CreateLineCharges (input l_item_id,
                                   input ship_from,
                                   input part_order,
                                   input part_order_line).

         /* UPDATING IMMEDIATE PARENT CONTAINER WEIGHT FOR THE ITEM
          * CREATED*/
         l_par_cont = parent_container.abs_id.

         if available pt_mstr then
            l_pt_ship_wt = pt_ship_wt.
         else
            l_pt_ship_wt = part_wght.

         if substring(parent_container.abs_id ,1,1) = "C" then do:

            l_conv = 1.

            /* CONSIDERING CHANGES IN NET WEIGHT UM IN THE ITEM  */
            /* INFORMATION FRAME AND ACCORDINGLY ADJUSTING THE   */
            /* THE NET AND GROSS WEIGHTS OF THE PARENT CONTAINER */
            if (parent_container.abs_wt_um <> "" ) and
               part_wt_um <> parent_container.abs_wt_um
            then do:
               /* INTERCHANGED FIRST TWO PARAMETERS */
               {gprun.i ""gpumcnv.p""
                  "(part_wt_um,
                    parent_container.abs_wt_um,
                    """",
                    output l_conv)" }
/*GUI*/ if global-beam-me-up then undo, leave.


               if l_conv = ? then
                  l_conv = 1.
            end.  /* IF PARENT_CONTAINER.ABS_WT_UM <> " " AND ...   */

            if l_pt_ship_wt = 0 and part_wght <> 0 then
               /* ASSIGN NET WT TO GROSS WT IF ITEM SHIP WT IS ZERO  */
               /* IN PART MASTER                                     */
               assign
                  parent_container.abs_nwt = parent_container.abs_nwt +
                     maximum(part_wght * l_this_rec_qty * part_qty_conv,0)
                     * l_conv
                  parent_container.abs_gwt =  parent_container.abs_gwt +
                     maximum(part_wght * l_this_rec_qty * part_qty_conv,0)
                     * l_conv.
            else
               assign
                  parent_container.abs_nwt = parent_container.abs_nwt +
                     maximum(part_wght * l_this_rec_qty * part_qty_conv,0)
                        * l_conv
                  parent_container.abs_gwt = parent_container.abs_gwt +
                     maximum(l_pt_ship_wt * l_this_rec_qty * part_qty_conv,0)
                        * l_conv.

            if parent_container.abs_wt_um = "" then
               parent_container.abs_wt_um = part_wt_um.

         end.  /* IF SUBSTRING(PARENT_CONTAINER.ABS_ID, 1, 1) = 'c' */

         /* Gather additional line item data */
         {gprun.i ""sofsgi.p"" "(line_recno)" }
/*GUI*/ if global-beam-me-up then undo, leave.


         /*MAINTAIN CONTAINER AND LINE CHARGE DATA*/
         if using_container_charges or
            using_line_charges then do:
            run getUserFieldData (input l_item_id, input ship_from).

            if using_line_charges and part_order <> ""
               then do:
               run getLineCharges (input l_item_id,
                                   input ship_from,
                                   input vSoRecno,
                                   input vSodRecno).
                view frame a.
                pause 0.
            end. /*IF USING_LINE_CHARGES*/
         end. /*IF USING_CONTAINER_CHARGES */

         if work_sr_wkfl.sr_qty = 0 then do:
            delete work_sr_wkfl.
            qty_to_set = 0.
         end. /* IF WORK_SR_WKFL.SR_QTY = 0 THEN */

      end. /* DO WHILE QTY_TO_SET > 0 */

   end.
/*GUI*/ if global-beam-me-up then undo, leave.
 /* FOR EACH PARENT_CONTAINER */

   for first abs_buff2
   fields (abs_cmtindx abs_dataset abs_fa_lot abs_format
           abs_gwt abs_id abs_item abs_lang abs_line abs_loc
           abs_lotser abs_nwt abs_order abs_par_id abs_qty
           abs_ref abs_shipfrom abs_shipto abs_shp_date abs_site
           abs_type abs_vol abs_vol_um abs__qad02 abs__qad03
           abs__qad06 abs__qad10)
   where abs_buff2.abs_shipfrom = ship_from and
         abs_buff2.abs_id       = l_par_cont
   no-lock: end.

   if available abs_buff2 then do:

      if substring(abs_buff2.abs_id, 1, 1) = "C" then do:

         /* IF THE IMMEDIATE PARENT OF THE ITEM CREATED IS CONTAINER   */
         /* THEN THE ITEM WTS SHOULD NOT BE ROLLED UP TO CONTAINER     */
         /* SINCE THIS ALREADY DONE IN THE PARENT_CONTAINER LOOP ABOVE */

         /* FINDING PARENT RECORD OF THE CONTAINER */
         for first abs_buff1
         fields (abs_cmtindx abs_dataset abs_fa_lot abs_format
                 abs_gwt abs_id abs_item abs_lang abs_line abs_loc
                 abs_lotser abs_nwt abs_order abs_par_id abs_qty
                 abs_ref abs_shipfrom abs_shipto abs_shp_date abs_site
                 abs_type abs_vol abs_vol_um abs__qad02 abs__qad03
                 abs__qad06 abs__qad10)
         where abs_buff1.abs_shipfrom = abs_buff2.abs_shipfrom and
               abs_buff1.abs_id       = abs_buff2.abs_par_id
         no-lock: end.

         if available abs_buff1 then
            l_recid = recid(abs_buff1).

      end. /* IF SUBSTRING(ABS_BUFF2,ABS_ID,1,1) = "C"  */

      else
         l_recid = recid(abs_buff2).

      /* ROLLUP NET WEIGHT */
      {gprun.i ""icshnwt.p""
         "(input l_recid,
           input l_abs_tot_net_wt,
           input yes,
           input part_wt_um)"}
/*GUI*/ if global-beam-me-up then undo, leave.


      /* ROLLUP TARE WEIGHT */
      {gprun.i ""icshnwt.p""
         "(input l_recid,
           input l_abs_tot_tare_wt,
           input no,
           input part_wt_um)"}
/*GUI*/ if global-beam-me-up then undo, leave.


   end. /* IF AVAILABLE ABS_BUFF2 */

   abnormal_exit = false.

end. /* main */

hide frame a no-pause.

{rcinvcon.i}

PROCEDURE p_create_item:
/*--------------------------------------------------------------------
  Purpose:     Created Container Records
  Parameters:
  Notes:       Rollup of item weights to its parents is not done here
---------------------------------------------------------------------*/
   /* INPUT PARAMETERS */
   define input parameter cont_shipfrom    like abs_shipfrom.
   define input parameter cont_shipto      like abs_shipto.
   define input parameter cont_id          like abs_id.
   define input parameter cont_parid       like abs_par_id.
   define input parameter cont_qty         like abs_qty.
   define input parameter cont_item        like abs_item.
   define input parameter cont_loc         like abs_loc.
   define input parameter cont_lot         like abs_lot.
   define input parameter cont_ref         like abs_ref.
   define input parameter cont_wt          like abs_nwt.
   define input parameter cont_wt_um       like abs_wt_um.
   define input parameter cont_vol         like abs_vol.
   define input parameter cont_vol_um      like abs_vol_um.
   define input parameter cont_site        like abs_site.
   define input parameter cont_qty_um      like abs__chr02.
   define input parameter cont_qty_conv    as decimal.
   define input parameter cont_gwt         like abs_gwt.
   define input parameter cmtindx          like abs_cmtindx.
   define input parameter cont_order       like abs_order.
   define input parameter cont_line        like abs_line.

   /* OUTPUT PARAMETERS */
   define output parameter line_recno as recid.

   /* LOCAL VARIABLES */
   define variable l_abs_tare_wt like abs_nwt no-undo.
   define variable cont_level       as integer     no-undo.
   define variable cont_child       like abs_id    no-undo.
   define variable part_fa_lot      like wo_lot    no-undo.

   /* BUFFERS */
   define buffer child_container for abs_mstr.

   assign
      cont_level = 1
      cont_child = "NONE"
      part_fa_lot = "".

   create abs_mstr.
   assign
      abs_mstr.abs_shipfrom = cont_shipfrom
      abs_mstr.abs_id       = cont_id
      abs_mstr.abs_shipto   = cont_shipto
      abs_mstr.abs_par_id   = cont_parid
      abs_mstr.abs_qty      = cont_qty
      abs_mstr.abs_shp_date = today
      abs_mstr.abs_type     = "s"
      abs_mstr.abs_item     = cont_item
      abs_mstr.abs_loc      = cont_loc
      abs_mstr.abs_lot      = cont_lot
      abs_mstr.abs__qad06   = string(cont_level,"99")
      abs_mstr.abs_ref      = cont_ref
      abs_mstr.abs_gwt      = maximum(cont_gwt * cont_qty,0)
                               * cont_qty_conv
      abs_mstr.abs_nwt      = maximum(cont_wt * cont_qty,0)
                               * cont_qty_conv
      abs_mstr.abs_vol      = maximum(cont_vol * cont_qty * cont_qty_conv, 0)
      abs_mstr.abs_vol_um   = cont_vol_um
      abs_mstr.abs_wt_um    = cont_wt_um
      abs_mstr.abs_site     = cont_site
      abs_mstr.abs__qad02   = cont_qty_um
      abs_mstr.abs__qad03   = string(cont_qty_conv)
      abs_cmtindx           = cmtindx
      abs_mstr.abs_order    = cont_order
      abs_mstr.abs_line     = cont_line
      abs_mstr.abs_fa_lot   = part_fa_lot.


   assign
      l_abs_tare_wt = maximum((cont_gwt * cont_qty * cont_qty_conv) -
                              (cont_wt * cont_qty * cont_qty_conv),0).

   {abspack.i "abs_mstr" 26 22 "l_abs_tare_wt" }

   line_recno = recid(abs_mstr).

   /* ASSIGN NET WT TO GROSS WT IF ITEM SHIP WT IS ZERO  */
   /* IN PART MASTER                                     */
   if abs_mstr.abs_gwt = 0 and abs_mstr.abs_nwt <> 0 then
      abs_mstr.abs_gwt = abs_mstr.abs_nwt.

   /* ACCUMULATING WEIGHTS OF CHILD ITEMS TO BE ROLLED UP          */
   /* TO ITS PARENT                                                */
   assign
      l_abs_tot_tare_wt  = l_abs_tot_tare_wt + l_abs_tare_wt
      l_abs_tot_net_wt   = l_abs_tot_net_wt  + abs_mstr.abs_nwt.

   if cont_child <> "NONE"
   then do:

      find child_container
         where child_container.abs_shipfrom = cont_shipfrom
           and child_container.abs_id = cont_child
      exclusive-lock no-error.

      if available child_container then
         child_container.abs_par_id = abs_mstr.abs_id.

   end. /* IF CONT_CHILD <> "NONE" */

   if recid(abs_mstr) = -1 then.

END PROCEDURE.

PROCEDURE CreateUserFields:
   define input parameter ipShipFrom like abs_shipfrom no-undo.
   define input parameter ipShipTo like abs_shipto no-undo.
   define input parameter ipAbsID like abs_id no-undo.

   {gprunmo.i
          &program = ""sosob1b.p""
          &module  = "ACL"
          &param   = """(input ipAbsID,
                         input ipShipFrom,
                         input ipShipTo,
                         input 2)"""}

END PROCEDURE. /*CreateUserFields*/

PROCEDURE CreateLineCharges:
   define input parameter ipAbsID like abs_id no-undo.
   define input parameter ipShipfrom like abs_shipfrom no-undo.
   define input parameter ipOrder like abs_order no-undo.
   define input parameter ipLine like sod_line no-undo.

   {gprunmo.i
          &program = ""sosob1c.p""
          &module = "ACL"
          &param = """(input ipAbsID,
                       input ipShipfrom,
                       input ipOrder,
                       input ipLine)"""}

END PROCEDURE. /*CreateLineCharges*/


PROCEDURE getUserFieldData:
   define input parameter ipAbsID like abs_id.
   define input parameter ipShipFrom like abs_shipfrom.

   define variable vFieldCounter as integer no-undo.
   define variable vFieldList as character no-undo.
   define variable vFieldName as character no-undo.


   vFieldList = "part_item,part_order," +
                "part_order_line,part_qty,part_site," +
                "part_qty_um,part_loc,part_qty_conv," +
                "part_lot_ser,part_ref,part_wght," +
                "part_wt_um,multiple,part_vol,part_vol_um,cmmts".


   do vFieldCounter = 1 to num-entries(vFieldList,","):
     vFieldName = entry(vFieldCounter,vFieldList,",").
     if can-find(first absd_det where
             absd_abs_id = ipAbsID
         and absd_shipfrom = ipShipFrom
         and absd_abs_fld_name = vFieldName
         and absd_fld_prompt = yes)
     then do:
         {gprunmo.i
                  &module = "ACL"
                  &program = ""rcswbuf.p""
                  &param   = """(input yes,
                                 input vFieldName,
                                 input ipAbsID,
                                 input ipShipFrom)"""}
     end. /*IF CAN-FIND*/
   end. /* DO vFieldCounter = 1 TO */

   if can-find(first absd_det where
         absd_abs_id = ipAbsID
     and absd_shipfrom = ipShipFrom
     and absd_abs_fld_name = ""
     and absd_fld_prompt = yes)
   then do:

     {gprunmo.i
              &module  = "ACL"
              &program = ""rcswbuf.p""
              &param   = """(input no,
                             input "''",
                             input ipAbsID,
                             input ipShipFrom)"""}
   end. /*IF CAN_FIND */
END PROCEDURE. /*getUserFieldData*/


PROCEDURE getLineCharges:
   define input parameter ipAbsID like abs_id.
   define input parameter ipShipFrom like abs_shipfrom.
   define input parameter ipSoRecID as recid.
   define input parameter ipSodRecID as recid.

     {gprunmo.i
              &module  = "ACL"
              &program = ""rcabslmt.p""
              &param   = """(input ipSoRecID,
                             input ipSodRecID,
                             input ipAbsID,
                             input ipShipFrom)"""}

END PROCEDURE. /*getLineCharges*/

PROCEDURE validateSOFrTerms:
/*--------------------------------------------------------------------
   Purpose:     Get the highest level parent abs_mstr record
                Get the first order attached to this parent along with
                   the freight terms on this order.
                Compare the terms on this order to that of the input parameter
                  ip_OrderFrTerms and return op_FrTermsErr if they are
                  different.
   Parameters:
   Notes:
----------------------------------------------------------------------*/
   define input parameter ip_ShipFrom   as   character    no-undo.
   define input parameter ip_TempParent   as   character    no-undo.
   define input parameter ip_OrderFrTerms like so_fr_terms  no-undo.

   define output parameter op_FrTermsOnFirstOrder as character  no-undo.
   define output parameter op_FrTermsErr like mfc_logical  no-undo.

   define buffer b1_abs_mstr for abs_mstr.
   define buffer b2_abs_mstr for abs_mstr.

   define variable par_absid like abs_id no-undo.
   define variable par_shipfrom like abs_shipfrom no-undo.
   define variable l_FirstOrder like so_nbr no-undo.

   l_FirstOrder = "".

   for first b1_abs_mstr
   where recid(b1_abs_mstr) =
   integer(substring(ip_TempParent,(index(ip_TempParent,"::") + 2)))
   no-lock:
   end.

   if not available b1_abs_mstr then
      for first b1_abs_mstr
      where b1_abs_mstr.abs_shipfrom = ip_ShipFrom
        and b1_abs_mstr.abs_shipto = ip_TempParent
      no-lock:
      end.

   if available b1_abs_mstr then do:
      run get_abs_parent (input b1_abs_mstr.abs_id,
                          input b1_abs_mstr.abs_shipfrom,
                          output par_absid,
                          output par_shipfrom).
   end. /* IF AVAILABLE B1_ABS_MSTR */

   if par_absid <> ? then
   do for b2_abs_mstr:
      for first b2_abs_mstr where b2_abs_mstr.abs_id = par_absid and
         b2_abs_mstr.abs_shipfrom = par_shipfrom
         no-lock:
      end.
      if available b2_abs_mstr then do:
         {gprunmo.i  &module = "LA" &program = "lashex01.p"
                     &param  = """(buffer b2_abs_mstr,
                                   output l_FirstOrder,
                                   output op_FrTermsOnFirstOrder)"""}

         /* IF THERE IS AN ORDER ATTACHED TO THE PARENT ABS_MSTR,   */
         /* COMPARE THE FREIGHT TERMS ON THAT ORDER TO THOSE ON THE */
         /* ORDER BEING ATTACHED.                                   */

         if l_FirstOrder <> "" and
            op_FrTermsOnFirstOrder <> ip_OrderFrTerms then
         do:
            op_FrTermsErr = true.
            return.
         end. /* IF l_FirstOrder <> "" AND... */

      end. /* IF AVAILABLE b2_abs_mstr */
   end. /* DO FOR B2_ABS_MSTR */

END PROCEDURE. /* validateSOFrTerms */
